home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
database
/
tickle15.zip
/
TKLPACK.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1996-08-02
|
5KB
|
301 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 3.1O (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Boolean BOOLEAN002
Boolean BOOLEAN003
Integer INTEGER001
Integer INTEGER002
Real REAL001
Real REAL002
Real REAL003
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
String STRING006
String STRING007
Int INT001
Int INT002
Int INT003
Int INT004
Int INT005
Int INT006
Int INT007
Int INT008
;------------------------------------------------------------------------------
STRING006 = PPEPath() + "TKLTEXT" + LangExt()
Cls
Newlines 3
PrintLn ReadLine(STRING006, 59)
Newlines 2
Delay 18
Print ReadLine(STRING006, 60)
Gosub LABEL007
PrintLn ReadLine(STRING006, 61)
Newline
Print ReadLine(STRING006, 62)
Gosub LABEL006
PrintLn ReadLine(STRING006, 61)
Newline
Print ReadLine(STRING006, 63)
Gosub LABEL009
If (DErr(0)) Then
SPrintLn ReadLine(STRING006, 64)
Log "Cannot open TICKLE.DBF (DataBase) in EXCLUSIVE mode - Aborting", 0
Else
Gosub LABEL010
If (DErr(0)) Then
SPrintLn ReadLine(STRING006, 4)
Log "Cannot open TICKLE.NDX (Index) - Aborting", 0
Else
PrintLn ReadLine(STRING006, 61)
Newline
PrintLn ReadLine(STRING006, 65)
Newline
Delay 36
Gosub LABEL001
If (INT006 > 0) Then
Newlines 2
PrintLn ReadLine(STRING006, 66)
Newlines 2
DTop 0
DPack 0
Endif
FPutLn 2, "Total Number of Records in Database After Pack : ", DRecCount(0)
FPutLn 2
FPutLn 2, "Total Users Deleted : ", INT006
FPutLn 2, " Time Completed : ", Time()
FClose 2
Newline
PrintLn ReadLine(STRING006, 67)
Newline
Goto LABEL008
End
:LABEL001
DTop 0
PrintLn ReadLine(STRING006, 68)
Newline
FAppend 2, PPEPath() + PPEName() + ".log", 1, 0
FPutLn 2
FPutLn 2
FPutLn 2, "========================================================================"
FPutLn 2
FPutLn 2, "Tickle File Packing Program - Version 1.10"
FPutLn 2, "Written by Dan Shore - SysOp - The Shoreline BBS"
FPutLn 2
FPutLn 2, " Date of Pack : ", Date()
FPutLn 2, "Start Time of Pack : ", Time()
FPutLn 2
For INT001 = 1 To DRecCount(0)
StartDisp 1
DGo 0, INT001
STRING001 = DGet(0, DName(0, 1))
STRING003 = Left(STRING001, 1)
If (STRING003 < "A") STRING003 = "A"
If (STRING003 > "Z") STRING003 = "Z"
FPut 2, "Processing Username: ", STRING001
If (INT007) Goto LABEL002
Print ReadLine(STRING006, 69)
INT007 = GetX()
INT008 = GetY()
:LABEL002
AnsiPos INT007, INT008
Print INT001
Gosub LABEL003
BOOLEAN003 = 0
If ((STRING007 == "TRUE") && BOOLEAN002) Gosub LABEL011
If (!BOOLEAN002 || ((STRING007 == "TRUE") && (BOOLEAN003 == "FALSE"))) Then
If (!BOOLEAN002) FPutLn 2, "Not Current User - Deleted"
If ((BOOLEAN002 && (STRING007 == "TRUE")) && (BOOLEAN003 == 0)) FPutLn 2, "No Files - Deleted"
DDelete 0
Inc INT006
Continue
Endif
FPutLn 2, "Current User"
Next
PrintLn "@X07"
FPutLn 2
FPutLn 2, "Total Number of Records in Database Before Pack : ", DRecCount(0)
StartDisp 2
Return
:LABEL003
STRING004 = STRING002 + "PCBNDX." + STRING003
INTEGER001 = FileInf(STRING004, 4)
If (INTEGER001 < 27) Then
PrintLn ReadLine(STRING006, 70), STRING004, ReadLine(STRING006, 71)
Endif
INT004 = INTEGER001 / 27
INT005 = 0
FOpen 1, STRING004, 0, 0
BOOLEAN001 = 0
BOOLEAN002 = 0
:LABEL004
If (BOOLEAN001) Goto LABEL005
REAL001 = INT004
REAL002 = INT005
REAL001 = REAL001 / 2
REAL002 = REAL002 / 2
REAL003 = REAL001 + REAL002 + 0.5
INT003 = REAL003
INTEGER002 = (INT003 - 1) * 27
FSeek 1, INTEGER002, 0
FRead 1, INT002, 2
FRead 1, STRING005, 25
If (STRING005 == STRING001) Then
BOOLEAN002 = 1
BOOLEAN001 = 1
ElseIf (INT004 - INT005 < 2) Then
BOOLEAN001 = 1
ElseIf (STRING005 < STRING001) Then
INT005 = INT003
ElseIf (STRING005 > STRING001) Then
INT004 = INT003
Endif
Goto LABEL004
:LABEL005
FClose 1
Return
:LABEL006
Copy PPEPath() + "TICKLE.DBF", PPEPath() + "TICKLE.DBK"
Copy PPEPath() + "TICKLE.NDX", PPEPath() + "TICKLE.NBK"
Return
:LABEL007
FOpen 1, PPEPath() + PPEName() + ".cfg", 0, 0
FGet 1, STRING002
FGet 1, STRING007
If (Ferr(1)) STRING007 = "FALSE"
FClose 1
If (STRING007 <> "TRUE") STRING007 = "FALSE"
STRING002 = Trim(STRING002, " ")
If (Right(STRING002, 1) <> "\") STRING002 = STRING002 + "\"
Return
Endif
Endif
:LABEL008
DnCloseAll 0
DClose 0
PrintLn ReadLine(STRING006, 72)
Newline
End
:LABEL009
DOpen 0, PPEPath() + "tickle", 1
Return
:LABEL010
If (Exist(PPEPath() + "tickle.ndx")) DnOpen 0, PPEPath() + "tickle"
Return
:LABEL011
If (DGet(0, DName(0, 2)) <> " ") BOOLEAN003 = 1
Return
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 2 End
; 1 Cls
; 21 Goto
; 33 Let
; 5 Print
; 11 PrintLn
; 22 If
; 2 FOpen
; 1 FAppend
; 3 FClose
; 2 FGet
; 1 FPut
; 19 FPutLn
; 2 StartDisp
; 2 Log
; 7 Gosub
; 7 Return
; 2 Delay
; 1 Inc
; 8 Newline
; 4 Newlines
; 1 AnsiPos
; 2